home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / fb386 / graf / a21.bas < prev    next >
BASIC Source File  |  1993-11-30  |  2KB  |  58 lines
  1. 1000 'A21.BAS***************************************************T.K.MOSAKU
  2. 1010 SCREEN@ 2:WINDOW (0,0)-(640,480):CLS
  3. 1015 CD PLAY 2
  4. 1020 A1$=" 一つの球形を描き, "
  5. 1030 A2$="GET@ 命令で取り込み, PUT@ 命令で表示します｡ "
  6. 1040 A3$="途中で球形の色が, 背景とともに４度変わります｡"
  7. 1050 A1=LEN(A1$):B1=(80-A1)\2:LOCATE 0, 9:PRINT SPACE$(B1)+A1$
  8. 1060 A2=LEN(A2$):B2=(80-A2)\2:LOCATE 0,11:PRINT SPACE$(B2)+A2$
  9. 1070 A3=LEN(A3$):B3=(80-A3)\2:LOCATE 0,13:PRINT SPACE$(B3)+A3$
  10. 1080 T1=TIME:S=1 
  11. 1090 FOR J=0 TO 255
  12. 1100   PALETTE J,[J,0,0],1
  13. 1110 NEXT
  14. 1120 X0=100:Y0=100:WW=50
  15. 1130 '
  16. 1140 GOSUB *CUBE
  17. 1150 DIM A%(6000) 
  18. 1160 GET@A (X0-WW,Y0-WW)-(X0+WW,Y0+WW),A%
  19. 1170 '
  20. 1180 T1=TIME:CLS
  21. 1190 X0=20:Y0=10:X2=5:Y2=3.7!:GOSUB *MAIN
  22. 1200 X0=20:Y0=10:X2=5:Y2=2   :GOSUB *MAIN
  23. 1210 X0=20:Y0=10:X2=5:Y2=.3! :GOSUB *MAIN
  24. 1220 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "描き上げる時間--";T;"秒｡" 
  25. 1230 GOTO 1330
  26. 1240 *MAIN
  27. 1250  FOR J=1 TO 12
  28. 1260    X1=X2*(J+1):Y1=Y2*(J+1)
  29. 1270    X0=X0+X1:Y0=Y0+Y1
  30. 1280    XX=.1!*(J+1):YY=.1!*(J+1)
  31. 1290    PUT@A (X0,Y0)-(X0+100,Y0+100),A%,MATTE,XX,YY,0
  32. 1300  NEXT
  33. 1310 RETURN
  34. 1320 '
  35. 1330 WAIT 200:T1=TIME
  36. 1340 FOR J=0 TO 255:PALETTE J,[255-J,255-J,    0],1:NEXT
  37. 1350 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "色を変える時間--";T;"秒｡" 
  38. 1360 '
  39. 1370 WAIT 200:T1=TIME
  40. 1380 FOR J=0 TO 255:PALETTE J,[J,        0,255-J],1:NEXT
  41. 1390 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "色を変える時間--";T;"秒｡" 
  42. 1400 '
  43. 1410 WAIT 200:T1=TIME
  44. 1420 FOR J=0 TO 255:PALETTE J,[255-J,255-J,255-J],1:NEXT
  45. 1430 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "色を変える時間--";T;"秒｡" 
  46. 1440 '
  47. 1450 WAIT 200:T1=TIME
  48. 1460 FOR J=0 TO 255:PALETTE J,[J,        J,    J],1:NEXT
  49. 1470 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "色を変える時間--";T;"秒｡" 
  50. 1480 '
  51. 1490 WAIT 200
  52. 1500 GOTO 1550
  53. 1510 '
  54. 1520 *CUBE
  55. 1530 FOR I=0 TO 255:CIRCLE (X0,Y0),WW*(255-I)/255,%I:NEXT
  56. 1540 RETURN
  57. 1550 '
  58.